home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0693 / BOOTRES.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-30  |  4KB  |  208 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 312 of 319
  3. From : Steve Mulligan                      1:163/307.30         23 Jun 93  10:24
  4. To   : Edward Walker
  5. Subj : TSRs that write to disk....
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Tuesday June 22 1993 02:38, Edward Walker wrote to All:
  8.  
  9.  EW> What do I need to set up in the code to write to disk in a TSR?
  10.  
  11. Here's a TSR called BootRes.  It opens a file and writes to disk every x
  12. seconds :}
  13.  
  14. program BootRes;
  15.  
  16. {$M 2048,0,0}
  17. {$F+}
  18.  
  19. Uses BootVars, Crt, Dos;
  20.  
  21. const
  22.  OLDSTACKSS :  WORD = 0;
  23.  OLDSTACKSP :  WORD = 0;
  24.  STACKSW :    INTEGER = - 1;
  25.  OurStackSeg : word = 0;
  26.  OurStackSp  : word = 0;
  27.  DosDelimSet : set of Char = ['\', ':', #0];
  28.  
  29. var
  30.  R                    : registers;
  31.  DosSeg, DosBusy              : word;
  32.  Tick, WaitBuf               : integer;
  33.  NeedPop                 : boolean;
  34.  
  35. PROCEDURE BEGINint;
  36. INLINE($FF/$06/STACKSW/
  37.    $75/$10/
  38.    $8C/$16/OLDSTACKSS/
  39.        $89/$26/OLDSTACKSP/
  40.        $8E/$16/OURSTACKSEG/
  41.        $8B/$26/OURSTACKSP);
  42.  
  43. PROCEDURE ENDint;
  44. INLINE($FF/$0E/STACKSW/
  45.        $7D/$08/
  46.        $8E/$16/OLDSTACKSS/
  47.    $8B/$26/OLDSTACKSP);
  48.  
  49. PROCEDURE CALLPOP(SUB:POINTER);
  50. BEGIN
  51. INLINE($FF/$5E/$06);
  52. END;
  53.  
  54. PROCEDURE CLI; INLINE($FA);
  55. PROCEDURE STI; INLINE($FB);
  56.  
  57. function Exist(fname : string) : boolean;
  58. var
  59.      f1  : file;  err : integer;
  60. begin
  61.      {$I-}
  62.      assign(f1,fname);     reset(f1);     err := ioresult;
  63.      {$I+}
  64.      if  err = 0 then close(f1);     exist := err = 0;
  65. end;
  66.  
  67.   function AddBackSlash(DirName : string) : string;
  68.     {-Add a default backslash to a directory name}
  69.   begin
  70.     if DirName[Length(DirName)] in DosDelimSet then
  71.       AddBackSlash := DirName
  72.     else
  73.       AddBackSlash := DirName+'\';
  74.   end;
  75.  
  76. procedure TsrCrap;
  77. begin
  78.  CLI;
  79.  BEGINint;
  80.  STI;
  81.  
  82.  NeedPop := False;
  83.  
  84.  GetDate(h, m, s, hund);
  85.  TimeLoad.Year := h;
  86.  TimeLoad.Month := m;
  87.  TimeLoad.Day := s;
  88.  GetTime(h, m, s, hund);
  89.  TimeLoad.Hour := h;
  90.  TimeLoad.Min := m;
  91.  TimeLoad.Sec := s;
  92.  
  93.  DoDate;
  94.  DoDate2;
  95.  
  96.  if not exist(LogName) then begin
  97.   assign(LogFile, LogName);
  98.   rewrite(LogFile);
  99.   write(LogFile, LogRec);
  100.   close(LogFile);
  101.  end;
  102.  
  103.  assign(LogFile, LogName);
  104.  reset(LogFile);
  105.  if FileSize(LogFile) = 0 then begin
  106.   close(LogFile);
  107.   assign(LogFile, LogName);
  108.   rewrite(LogFile);
  109.   write(LogFile, LogRec);
  110.   close(LogFile);
  111.   assign(LogFile, LogName);
  112.   reset(LogFile);
  113.  end;
  114.  seek(LogFile, FileSize(LogFile) - 1);
  115.  read(LogFile, LogRec);
  116.  DoDate2;
  117.  seek(LogFile, FileSize(LogFile) - 1);
  118.  write(LogFile, LogRec);
  119.  close(LogFile);
  120.  Tick := 0;
  121.  
  122.  CLI;
  123.  ENDint;
  124.  STI;
  125. end;
  126.  
  127. procedure RunTSR; Interrupt;
  128. begin
  129.  CLI;
  130.  BEGINint;
  131.  STI;
  132.  inc(Tick);
  133.  if Tick > 18.2 * WaitBuf then begin
  134.   NeedPop := True;
  135.   if MEM[DosSeg:DosBusy] = 0 then begin
  136.    NeedPop := False;
  137.    PORT[$20] := $20;
  138.    TsrCrap;
  139.   end;
  140.  end;
  141.  CLI;
  142.  ENDint;
  143.  STI;
  144. end;
  145.  
  146. procedure Int28TSR; Interrupt;
  147. begin
  148.  CLI;
  149.  BEGINint;
  150.  STI;
  151.  if NeedPop = True then TsrCrap;
  152.  CLI;
  153.  ENDint;
  154.  STI;
  155. end;
  156.  
  157. procedure InitTSR;
  158. begin
  159.  OurStackSeg := SSEG;
  160.  InLine($89/$26/OurStackSp);
  161.  R.Ah := $34;
  162.  MSDOS(R);
  163.  DosSeg := R.ES;
  164.  DosBusy := R.BX;
  165. end;
  166.  
  167. procedure ShowHelp;
  168. begin
  169.  writeln('Usage : BOOTRES <command line options>');
  170.  writeln;
  171.  writeln('Valid Options : #    Number of seconds to wait before writing current
  172. time');
  173.  writeln('                /?   This screen');
  174. end;
  175.  
  176. begin
  177.  InitTSR;
  178.  
  179.  GetDir(0, LogName);
  180.  LogName := AddBackSlash(LogName) + 'BOOTLOG.DAT';
  181.  WaitBuf := 60;
  182.  
  183.  writeln;
  184.  
  185.  if ParamCount > 0 then begin
  186.   if ParamStr(1) = '/?' then begin
  187.    ShowHelp;
  188.    halt(0);
  189.   end;
  190.   val(ParamStr(1), WaitBuf, Tick);
  191.   if (Tick <> 0) or ((WaitBuf > 60 * 10) or (WaitBuf < 5)) then begin
  192.    writeln('Must be an integer between 5 and ', 60 * 10);
  193.    halt(1);
  194.   end;
  195.  end else begin
  196.   writeln('Type BOOTRES /? for help');
  197.   writeln;
  198.  end;
  199.  
  200.  Tick := 0;
  201.  
  202.  SetIntVec($28,@Int28TSR);
  203.  SetIntVec($1C,@RunTSR);
  204.  
  205.  writeln('BootRes installed');
  206.  
  207.  keep(0);
  208. end.